(* Yoann Padioleau
 *
 * Copyright (C) 2010-2014 Facebook
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file license.txt.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * license.txt for more details.
 *)
open Common

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(*
 * This module provides a big functor, PHP_VS_PHP, which can be used
 * to match some PHP AST elements against other PHP AST elements in
 * a flexible way.
 *
 * Most of the boilerplate code was generated by
 *
 *    pfff/meta/gen_code -matcher_gen_all ast_php.ml
 *
 * using OCaml pad-style reflection (see commons/ocaml.ml) on
 * parsing_php/ast_php.ml.
 *
 * An alternative is to transform ast_php.ml
 * in a very simple term language and do the 1-vs-1 match
 * on this term language. But depending on the construct, a PHP variable,
 * a string, we may want to do special things so maybe it is better to work
 * on the full AST? Working on a term language would be like working
 * in an untyped language? But I have to constantly update sgrep to
 * handle more patterns e.g. X::foo() should match AClass::foo(),
 * which would not happenif I just went with the simpler term language
 * from the beginning.
 * See pfff/matcher/fuzzy_vs_fuzzy.ml for another approach.
 *
 * I then hardcoded a few isomorphisms by abusing some existing constructs,
 * for instance constants starting with a big X are considered metavars
 * for expression.
 *
 * C-s "pad" or "iso" or any comment
 *
 *
 *)

(* A is the pattern, and B the concrete source code. For now
 * we both use the same module, Ast_php, but they may differ later
 * as the expressivity of the pattern language grows.
 *
 * subtle: use 'b' for to report errors, 'a' is the sgrep pattern and it
 * has no file information usually.
 *)
module A = Cst_php
module B = Cst_php
module MV = Metavars_php

(*****************************************************************************)
(* Globals *)
(*****************************************************************************)

(* PHP is case insensitive, which I think is a bad idea, so
 * tools like scheck enforce case sensitivity. But we want sgrep/spatch
 * to match/transform as much code as possible, including badly written
 * code with weird cases, hence this flag.
 *
 * Note that sgrep/spatch patterns can contain metavariables which are
 * in uppercase so we can't lowercase all idents at parsing time.
 * We have instead to do case insensitive string comparisons here.
 *)
let case_sensitive = ref false

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

(* Relaxed matching of PHP's Boolean and Int types. Only integer 0 converts
 * to false, all other integers evaluate to true.
 *)
let is_bool_vs_int b i =
  match (b, i) with
  | "false", "0" -> true
  | "true", n when n <> "0" -> true
  | _ -> false

let rec is_concat_of_strings e =
  match e with
  | A.Sc (A.C (A.String _)) -> true
  | A.Binary (e1, (A.BinaryConcat, _), e2) ->
      is_concat_of_strings e1 && is_concat_of_strings e2
  | _ -> false

let is_NoTransfo tok =
  match tok.Parse_info.transfo with Parse_info.NoTransfo -> true | _ -> false

let is_Remove tok =
  match tok.Parse_info.transfo with Parse_info.Remove -> true | _ -> false

(*****************************************************************************)
(* Functor parameter combinators *)
(*****************************************************************************)

(* This is the interface of the structure that will be passed to the
 * PHP_VS_PHP functor below.
 *)
module type PARAM = sig
  (* tin is for 'type in' and tout for 'type out' *)
  type tin

  type 'x tout

  (* A matcher is something taking an element A and an element B
   * (for PHP_VS_PHP below, A will be the AST of the PHP pattern and B
   * the AST of the PHP program we want to match over), then some environment
   * information tin, and it will return something (tout) that will
   * encapsulate the possible matched element A and B.
   *
   * If you just want to do a simple matcher that just returns
   * a boolean, then instantiate the PARAM struct with
   *   type tin = unit  (* no environment information *)
   *   type ('a * 'b) tout = ('a * 'b) option
   * and if the toplevel matching returns a None, then you know
   * A didn't match B.
   *)
  type ('a, 'b) matcher = 'a -> 'b -> tin -> ('a * 'b) tout

  (* The >>= combinator below allow you to configure the matching process
   * anyway you want. Essentially this combinator takes a matcher,
   * another matcher, and returns a matcher that combine the 2
   * matcher arguments.
   *
   * In the case of a simple boolean matcher, you just need to write:
   *
   *   let (>>=) m1 m2 = fun tin ->
   *    match m1 tin with
   *    | None -> None
   *    | Some (a,b) ->
   *        m2 (a, b) tin
   *)
  val ( >>= ) :
    (tin -> ('a * 'b) tout) ->
    ('a * 'b -> tin -> ('c * 'd) tout) ->
    tin ->
    ('c * 'd) tout

  (* the disjunctive combinator *)
  val ( >||> ) : (tin -> 'x tout) -> (tin -> 'x tout) -> tin -> 'x tout

  (* The classical monad combinators *)
  val return : 'a * 'b -> tin -> ('a * 'b) tout

  val fail : tin -> ('a * 'b) tout

  val tokenf : (A.info, B.info) matcher

  val envf : (Metavars_php.mvar Cst_php.wrap, Cst_php.any) matcher

  (* ugly hack for the "A" string metavariables *)
  val envf2 :
    (Metavars_php.mvar Cst_php.wrap, Cst_php.any * Cst_php.any) matcher
end

(*****************************************************************************)
(* Functor code, "PHP vs PHP" *)
(*****************************************************************************)

module PHP_VS_PHP =
functor
  (X : PARAM)
  ->
  struct
    type ('a, 'b) matcher = 'a -> 'b -> X.tin -> ('a * 'b) X.tout

    let ( >>= ) = X.( >>= )

    let ( >||> ) = X.( >||> )

    let return = X.return

    let fail () = X.fail

    let fail2 s =
      pr2 (spf "PHP_VS_PHP: TODO for %s" s);
      X.fail

    (* ---------------------------------------------------------------------- *)
    (* option, list, ref, either *)
    (* ---------------------------------------------------------------------- *)
    let (m_option : ('a, 'b) matcher -> ('a option, 'b option) matcher) =
     fun f a b ->
      match (a, b) with
      | None, None -> return (None, None)
      | Some xa, Some xb -> f xa xb >>= fun (xa, xb) -> return (Some xa, Some xb)
      | None, _ | Some _, _ -> fail ()

    let (m_ref : ('a, 'b) matcher -> ('a ref, 'b ref) matcher) =
     fun f a b ->
      match (a, b) with
      | { contents = xa }, { contents = xb } ->
          f xa xb >>= fun (xa, xb) ->
          return ({ contents = xa }, { contents = xb })

    let rec m_list f a b =
      match (a, b) with
      | [], [] -> return ([], [])
      | xa :: aas, xb :: bbs ->
          f xa xb >>= fun (xa, xb) ->
          m_list f aas bbs >>= fun (aas, bbs) -> return (xa :: aas, xb :: bbs)
      | [], _ | _ :: _, _ -> fail ()

    let m_either f g a b =
      match (a, b) with
      | Left a, Left b -> f a b >>= fun (a, b) -> return (Left a, Left b)
      | Right a, Right b -> g a b >>= fun (a, b) -> return (Right a, Right b)
      | Left _, Right _ | Right _, Left _ -> fail ()

    let m_either3 f g h a b =
      match (a, b) with
      | Left3 a, Left3 b -> f a b >>= fun (a, b) -> return (Left3 a, Left3 b)
      | Right3 a, Right3 b -> h a b >>= fun (a, b) -> return (Right3 a, Right3 b)
      | Middle3 a, Middle3 b ->
          g a b >>= fun (a, b) -> return (Middle3 a, Middle3 b)
      | Left3 _, _ | Right3 _, _ | Middle3 _, _ -> fail ()

    let m_unit a b = return (a, b)

    (* ---------------------------------------------------------------------- *)
    (* m_string *)
    (* ---------------------------------------------------------------------- *)
    let m_string a b = if a =$= b then return (a, b) else fail ()

    (* iso on case sensitivity *)
    let m_string_case a b =
      if !case_sensitive then m_string a b
      else m_string (String.lowercase_ascii a) (String.lowercase_ascii b)

    (* iso on different indentation *)
    let m_string_xhp_text (sa, ta) (sb, tb) =
      let does_match = sa =$= sb || (sa =~ "^[\n ]+$" && sb =~ "^[\n ]+$") in
      if does_match then
        X.tokenf ta tb >>= fun (ta, tb) -> return ((sa, ta), (sb, tb))
      else fail ()

    (* ---------------------------------------------------------------------- *)
    (* scope, type (don't care for now) *)
    (* ---------------------------------------------------------------------- *)
    let m_xxx_scope a b =
      (* dont care about scope for now *)
      return (a, b)

    (* ---------------------------------------------------------------------- *)
    (* tokens *)
    (* ---------------------------------------------------------------------- *)
    (* we dont care about position, space/indent/comment isomorphism
     * so we could just do  'return (a, b)'
     * but we need to propagate transformation at least.
     *)
    let m_info a b = X.tokenf a b

    let m_comma_list f a b = m_list (m_either f m_info) a b

    let m_tok a b = m_info a b

    let m_wrap f a b =
      match (a, b) with
      | (xaa, ainfo), (xbb, binfo) ->
          f xaa xbb >>= fun (xaa, xbb) ->
          m_info ainfo binfo >>= fun (ainfo, binfo) ->
          return ((xaa, ainfo), (xbb, binfo))

    let m_single_angle f a b =
      match (a, b) with
      | (a1, a2, a3), (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          f a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) -> return ((a1, a2, a3), (b1, b2, b3))

    let m_bracket f a b =
      match (a, b) with
      | (a1, a2, a3), (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          f a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) -> return ((a1, a2, a3), (b1, b2, b3))

    let m_brace f a b = m_bracket f a b

    let m_paren f a b = m_bracket f a b

    (* ---------------------------------------------------------------------- *)
    (* names *)
    (* ---------------------------------------------------------------------- *)
    let m_dname a b =
      match (a, b) with
      | A.DName a1, B.DName b1 ->
          m_wrap m_string a1 b1 >>= fun (a1, b1) ->
          return (A.DName a1, B.DName b1)

    let m_ident a b =
      match (a, b) with
      | A.Name a1, B.Name b1 ->
          (m_wrap m_string_case) a1 b1 >>= fun (a1, b1) ->
          return (A.Name a1, B.Name b1)
      | A.XhpName a1, B.XhpName b1 ->
          (m_wrap (m_list m_string)) a1 b1 >>= fun (a1, b1) ->
          return (A.XhpName a1, B.XhpName b1)
      | A.Name _, _ | A.XhpName _, _ -> fail ()

    let m_name_metavar_ok a b =
      match (a, b) with
      (* iso on name *)
      | A.Name (name, info_name), (B.Name _ | B.XhpName _)
        when MV.is_metavar_name name -> (
          X.envf (name, info_name) (B.Ident2 b) >>= function
          | (name, info_name), B.Ident2 b -> return (A.Name (name, info_name), b)
          | _ -> raise Impossible )
      | A.Name a1, B.Name b1 ->
          (m_wrap m_string_case) a1 b1 >>= fun (a1, b1) ->
          return (A.Name a1, B.Name b1)
      | A.XhpName ([ name ], info_name), B.XhpName _b1
        when MV.is_metavar_name name -> (
          X.envf (name, info_name) (B.Ident2 b) >>= function
          | (name, info_name), B.Ident2 b ->
              return (A.XhpName ([ name ], info_name), b)
          | _ -> raise Impossible )
      | A.XhpName a1, B.XhpName b1 ->
          (m_wrap (m_list m_string)) a1 b1 >>= fun (a1, b1) ->
          return (A.XhpName a1, B.XhpName b1)
      | A.Name _, _ | A.XhpName _, _ -> fail ()

    (* ---------------------------------------------------------------------- *)
    (* operators *)
    (* ---------------------------------------------------------------------- *)
    let m_arithOp a b =
      match (a, b) with
      | A.Plus, B.Plus -> return (A.Plus, B.Plus)
      | A.Minus, B.Minus -> return (A.Minus, B.Minus)
      | A.Mul, B.Mul -> return (A.Mul, B.Mul)
      | A.Div, B.Div -> return (A.Div, B.Div)
      | A.Mod, B.Mod -> return (A.Mod, B.Mod)
      | A.DecLeft, B.DecLeft -> return (A.DecLeft, B.DecLeft)
      | A.DecRight, B.DecRight -> return (A.DecRight, B.DecRight)
      | A.And, B.And -> return (A.And, B.And)
      | A.Or, B.Or -> return (A.Or, B.Or)
      | A.Xor, B.Xor -> return (A.Xor, B.Xor)
      | A.Plus, _
      | A.Minus, _
      | A.Mul, _
      | A.Div, _
      | A.Mod, _
      | A.DecLeft, _
      | A.DecRight, _
      | A.And, _
      | A.Or, _
      | A.Xor, _ ->
          fail ()

    let m_logicalOp a b =
      match (a, b) with
      | A.Inf, B.Inf -> return (A.Inf, B.Inf)
      | A.Sup, B.Sup -> return (A.Sup, B.Sup)
      | A.InfEq, B.InfEq -> return (A.InfEq, B.InfEq)
      | A.SupEq, B.SupEq -> return (A.SupEq, B.SupEq)
      | A.Eq, B.Eq -> return (A.Eq, B.Eq)
      | A.NotEq, B.NotEq -> return (A.NotEq, B.NotEq)
      | A.Identical, B.Identical -> return (A.Identical, B.Identical)
      | A.NotIdentical, B.NotIdentical -> return (A.NotIdentical, B.NotIdentical)
      | A.AndLog, B.AndLog -> return (A.AndLog, B.AndLog)
      | A.OrLog, B.OrLog -> return (A.OrLog, B.OrLog)
      | A.XorLog, B.XorLog -> return (A.XorLog, B.XorLog)
      | A.AndBool, B.AndBool -> return (A.AndBool, B.AndBool)
      | A.OrBool, B.OrBool -> return (A.OrBool, B.OrBool)
      | A.Inf, _
      | A.Sup, _
      | A.InfEq, _
      | A.SupEq, _
      | A.Eq, _
      | A.NotEq, _
      | A.Identical, _
      | A.NotIdentical, _
      | A.AndLog, _
      | A.OrLog, _
      | A.XorLog, _
      | A.AndBool, _
      | A.OrBool, _ ->
          fail ()

    let m_unaryOp a b =
      match (a, b) with
      | A.UnPlus, B.UnPlus -> return (A.UnPlus, B.UnPlus)
      | A.UnMinus, B.UnMinus -> return (A.UnMinus, B.UnMinus)
      | A.UnBang, B.UnBang -> return (A.UnBang, B.UnBang)
      | A.UnTilde, B.UnTilde -> return (A.UnTilde, B.UnTilde)
      | A.UnPlus, _ | A.UnMinus, _ | A.UnBang, _ | A.UnTilde, _ -> fail ()

    let m_binaryOp a b =
      match (a, b) with
      | A.Arith a1, B.Arith b1 ->
          m_arithOp a1 b1 >>= fun (a1, b1) -> return (A.Arith a1, B.Arith b1)
      | A.Logical a1, B.Logical b1 ->
          m_logicalOp a1 b1 >>= fun (a1, b1) ->
          return (A.Logical a1, B.Logical b1)
      | A.BinaryConcat, B.BinaryConcat -> return (A.BinaryConcat, B.BinaryConcat)
      | A.Pipe, B.Pipe -> return (A.Pipe, B.Pipe)
      | A.CombinedComparison, B.CombinedComparison ->
          return (A.CombinedComparison, B.CombinedComparison)
      | A.Arith _, _
      | A.Logical _, _
      | A.BinaryConcat, _
      | A.Pipe, _
      | A.CombinedComparison, _ ->
          fail ()

    let m_assignOp a b =
      match (a, b) with
      | A.AssignOpArith a1, B.AssignOpArith b1 ->
          m_arithOp a1 b1 >>= fun (a1, b1) ->
          return (A.AssignOpArith a1, B.AssignOpArith b1)
      | A.AssignConcat, B.AssignConcat -> return (A.AssignConcat, B.AssignConcat)
      | A.AssignOpArith _, _ | A.AssignConcat, _ -> fail ()

    let m_fixOp a b =
      match (a, b) with _ when a =*= b -> return (a, b) | _ -> fail ()

    (* ---------------------------------------------------------------------- *)
    (* cast, cpp directives  *)
    (* ---------------------------------------------------------------------- *)

    let m_ptype a b =
      match (a, b) with
      | A.BoolTy, B.BoolTy -> return (A.BoolTy, B.BoolTy)
      | A.IntTy, B.IntTy -> return (A.IntTy, B.IntTy)
      | A.DoubleTy, B.DoubleTy -> return (A.DoubleTy, B.DoubleTy)
      | A.StringTy, B.StringTy -> return (A.StringTy, B.StringTy)
      | A.ArrayTy, B.ArrayTy -> return (A.ArrayTy, B.ArrayTy)
      | A.ObjectTy, B.ObjectTy -> return (A.ObjectTy, B.ObjectTy)
      | A.BoolTy, _
      | A.IntTy, _
      | A.DoubleTy, _
      | A.StringTy, _
      | A.ArrayTy, _
      | A.ObjectTy, _ ->
          fail ()

    let m_castOp a b = m_ptype a b

    let m_cpp_directive a b =
      match (a, b) with
      | A.Line, B.Line -> return (A.Line, B.Line)
      | A.File, B.File -> return (A.File, B.File)
      | A.Dir, B.Dir -> return (A.Dir, B.Dir)
      | A.ClassC, B.ClassC -> return (A.ClassC, B.ClassC)
      | A.MethodC, B.MethodC -> return (A.MethodC, B.MethodC)
      | A.FunctionC, B.FunctionC -> return (A.FunctionC, B.FunctionC)
      | A.TraitC, B.TraitC -> return (A.TraitC, B.TraitC)
      | A.NamespaceC, B.NamespaceC -> return (A.NamespaceC, B.NamespaceC)
      | A.Line, _
      | A.File, _
      | A.Dir, _
      | A.ClassC, _
      | A.MethodC, _
      | A.FunctionC, _
      | A.TraitC, _
      | A.NamespaceC, _ ->
          fail ()

    (* ---------------------------------------------------------------------- *)
    (* lvalue *)
    (* ---------------------------------------------------------------------- *)

    let rec m_lvalue a b = m_expr a b

    and m_rw_variable a b = m_expr a b

    and m_w_variable a b = m_expr a b

    and m_name a b =
      match (a, b) with
      | A.XName a1, B.XName b1 ->
          m_fully_qualified_class_name a1 b1 >>= fun (a1, b1) ->
          return (A.XName a1, B.XName b1)
      | A.Self a1, B.Self b1 ->
          m_tok a1 b1 >>= fun (a1, b1) -> return (A.Self a1, B.Self b1)
      | A.Parent a1, B.Parent b1 ->
          m_tok a1 b1 >>= fun (a1, b1) -> return (A.Parent a1, B.Parent b1)
      | A.LateStatic a1, B.LateStatic b1 ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          return (A.LateStatic a1, B.LateStatic b1)
      | A.XName _, _ | A.Self _, _ | A.Parent _, _ | A.LateStatic _, _ ->
          fail ()

    and m_type_args a b =
      (m_single_angle (m_comma_list m_hint_type)) a b >>= fun (a, b) ->
      return (a, b)

    and m_fully_qualified_class_name a b =
      match (a, b) with
      | [], [] -> raise Impossible
      | [ A.QI a ], [ B.QI b ] ->
          (* iso on class name *)
          m_name_metavar_ok a b >>= fun (a, b) -> return ([ A.QI a ], [ B.QI b ])
      | A.QITok a :: xs, B.QITok b :: ys ->
          m_info a b >>= fun (a, b) ->
          m_fully_qualified_class_name xs ys >>= fun (xs, ys) ->
          return (A.QITok a :: xs, A.QITok b :: ys)
      | A.QI a :: xs, B.QI b :: ys ->
          m_name_metavar_ok a b >>= fun (a, b) ->
          m_fully_qualified_class_name xs ys >>= fun (xs, ys) ->
          return (A.QI a :: xs, B.QI b :: ys)
      | A.QI _ :: _, _ | A.QITok _ :: _, _ | [], _ -> fail ()

    (*---------------------------------------------------------------------------*)
    (* argument *)
    (*---------------------------------------------------------------------------*)
    and m_argument a b =
      match (a, b) with
      | A.Arg a1, B.Arg b1 -> (
          match (a1, b1) with
          | ( A.Assign (A.IdVar (_aname, _ascope), _atok, _aexpr),
              B.Assign (B.IdVar (_bname, _bscope), _btok, _bexpr) ) ->
              m_expr a1 b1 >>= fun (a1, b1) -> return (A.Arg a1, B.Arg b1)
          (* iso on keyword argument, keyword is optional in pattern *)
          | a1, B.Assign (B.IdVar (bname, bscope), btok, bexpr) ->
              (* todo: should allow this only in sgrep mode? what about spatch? *)
              m_expr a1 bexpr >>= fun (a1, bexpr) ->
              return
                ( A.Arg a1,
                  B.Arg (B.Assign (B.IdVar (bname, bscope), btok, bexpr)) )
          | a1, b1 ->
              m_expr a1 b1 >>= fun (a1, b1) -> return (A.Arg a1, B.Arg b1) )
      (* an expression metavariable should also match a reference argument *)
      | ( A.Arg (A.Id (A.XName [ A.QI (A.Name (name, info_name)) ])),
          B.ArgRef (_, _) )
        when MV.is_metavar_name name -> (
          X.envf (name, info_name) (B.Argument b) >>= function
          | (name, info_name), B.Argument b ->
              return
                (A.Arg (A.Id (A.XName [ A.QI (A.Name (name, info_name)) ])), b)
          | _ -> raise Impossible )
      | A.ArgRef (a1, a2), B.ArgRef (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_w_variable a2 b2 >>= fun (a2, b2) ->
          return (A.ArgRef (a1, a2), B.ArgRef (b1, b2))
      | A.ArgUnpack (a1, a2), B.ArgUnpack (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_w_variable a2 b2 >>= fun (a2, b2) ->
          return (A.ArgUnpack (a1, a2), B.ArgUnpack (b1, b2))
      | A.Arg _, _ | A.ArgRef _, _ | A.ArgUnpack _, _ -> fail ()

    (* ---------------------------------------------------------------------- *)
    (* expr *)
    (* ---------------------------------------------------------------------- *)
    and m_expr a b =
      match (a, b) with
      (* special case, metavars !! *)
      | A.Id (A.XName [ A.QI (A.Name (name, info_name)) ]), e2
        when MV.is_metavar_name name -> (
          X.envf (name, info_name) (B.Expr e2) >>= function
          | (name, info_name), B.Expr e2 ->
              return (A.Id (A.XName [ A.QI (A.Name (name, info_name)) ]), e2)
          | _ -> raise Impossible )
      (* pad *)
      | A.SgrepExprDots _, _ -> fail ()
      | _, B.SgrepExprDots _ ->
          pr2 "weird, have a ... in source; they are allowed only in patterns";
          fail ()
      (* iso on concatenation of strings *)
      | A.Sc (A.C (A.String ("...", info_string))), e
        when is_concat_of_strings e ->
          (* todo: propagate the transformation of info_string to e for spatch *)
          return (A.Sc (A.C (A.String ("...", info_string))), e)
      (* MPS: iso when argument *isn't* a hard-coded string. *)
      | A.Sc (A.C (A.String ("!...", info_string))), e
        when not (is_concat_of_strings e) ->
          return (A.Sc (A.C (A.String ("!...", info_string))), e)
      | A.Id a1, B.Id b1 ->
          m_name a1 b1 >>= fun (a1, b1) -> return (A.Id a1, B.Id b1)
      (* pad, iso on variable name *)
      | A.IdVar (A.DName (dname, info_dname), a2), B.IdVar (_b1, _b2)
        when MV.is_metavar_variable_name ("$" ^ dname) -> (
          (* we don't want expr metavariable and variable metavariable
           * to collide, so X and $X are different keys in the environment
           *)
          X.envf ("$" ^ dname, info_dname) (B.Expr b)
          >>= function
          | (dname, info_dname), B.Expr b ->
              return (A.IdVar (A.DName (dname, info_dname), a2), b)
          | _ -> raise Impossible )
      | A.IdVar (a1, a2), B.IdVar (b1, b2) ->
          m_dname a1 b1 >>= fun (a1, b1) ->
          m_ref m_xxx_scope a2 b2 >>= fun (a2, b2) ->
          return (A.IdVar (a1, a2), B.IdVar (b1, b2))
      | A.This a1, B.This b1 ->
          m_tok a1 b1 >>= fun (a1, b1) -> return (A.This a1, B.This b1)
      | A.Call (a1, a2), B.Call (b1, b2) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_paren m_list__m_argument a2 b2 >>= fun (a2, b2) ->
          return (A.Call (a1, a2), B.Call (b1, b2))
      | A.ObjGet (a1, a2, a3), B.ObjGet (b1, b2, b3) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          return (A.ObjGet (a1, a2, a3), B.ObjGet (b1, b2, b3))
      | A.ClassGet (a1, a2, a3), B.ClassGet (b1, b2, b3) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          return (A.ClassGet (a1, a2, a3), B.ClassGet (b1, b2, b3))
      | A.ArrayGet (a1, a2), B.ArrayGet (b1, b2) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          (m_bracket (m_option m_expr)) a2 b2 >>= fun (a2, b2) ->
          return (A.ArrayGet (a1, a2), B.ArrayGet (b1, b2))
      | A.HashGet (a1, a2), B.HashGet (b1, b2) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_brace m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.HashGet (a1, a2), B.HashGet (b1, b2))
      | A.BraceIdent a2, B.BraceIdent b2 ->
          m_brace m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.BraceIdent a2, B.BraceIdent b2)
      | A.Deref (a1, a2), B.Deref (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Deref (a1, a2), B.Deref (b1, b2))
      | A.Sc a1, B.Sc b1 ->
          m_scalar a1 b1 >>= fun (a1, b1) -> return (A.Sc a1, B.Sc b1)
      | A.Binary (a1, a2, a3), B.Binary (b1, b2, b3) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_wrap m_binaryOp a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          return (A.Binary (a1, a2, a3), B.Binary (b1, b2, b3))
      | A.Unary (a1, a2), B.Unary (b1, b2) ->
          m_wrap m_unaryOp a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Unary (a1, a2), B.Unary (b1, b2))
      | A.Assign (a1, a2, a3), B.Assign (b1, b2, b3) ->
          m_lvalue a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          return (A.Assign (a1, a2, a3), B.Assign (b1, b2, b3))
      | A.AssignOp (a1, a2, a3), B.AssignOp (b1, b2, b3) ->
          m_lvalue a1 b1 >>= fun (a1, b1) ->
          m_wrap m_assignOp a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          return (A.AssignOp (a1, a2, a3), B.AssignOp (b1, b2, b3))
      | A.Postfix (a1, a2), B.Postfix (b1, b2) ->
          m_rw_variable a1 b1 >>= fun (a1, b1) ->
          m_wrap m_fixOp a2 b2 >>= fun (a2, b2) ->
          return (A.Postfix (a1, a2), B.Postfix (b1, b2))
      | A.Infix (a1, a2), B.Infix (b1, b2) ->
          m_wrap m_fixOp a1 b1 >>= fun (a1, b1) ->
          m_rw_variable a2 b2 >>= fun (a2, b2) ->
          return (A.Infix (a1, a2), B.Infix (b1, b2))
      | A.CondExpr (a1, a2, a3, a4, a5), B.CondExpr (b1, b2, b3, b4, b5) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_option m_expr a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          m_expr a5 b5 >>= fun (a5, b5) ->
          return
            (A.CondExpr (a1, a2, a3, a4, a5), B.CondExpr (b1, b2, b3, b4, b5))
      | A.AssignList (a1, a2, a3, a4), B.AssignList (b1, b2, b3, b4) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_paren (m_comma_list m_list_assign) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          m_expr a4 b4 >>= fun (a4, b4) ->
          return (A.AssignList (a1, a2, a3, a4), B.AssignList (b1, b2, b3, b4))
      (* todo: isomorphism to abstract away the array long vs short syntax ? *)
      | A.ArrayLong (a1, a2), B.ArrayLong (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_paren m_list__m_array_pair a2 b2 >>= fun (a2, b2) ->
          return (A.ArrayLong (a1, a2), B.ArrayLong (b1, b2))
      | A.ArrayShort a1, B.ArrayShort b1 ->
          m_bracket m_list__m_array_pair a1 b1 >>= fun (a1, b1) ->
          return (A.ArrayShort a1, B.ArrayShort b1)
      | A.Collection (a1, a2), B.Collection (b1, b2) ->
          m_name a1 b1 >>= fun (a1, b1) ->
          m_brace (m_comma_list m_array_pair) a2 b2 >>= fun (a2, b2) ->
          return (A.Collection (a1, a2), B.Collection (b1, b2))
      | A.New (a1, a2, a3), B.New (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_class_name_reference a2 b2 >>= fun (a2, b2) ->
          m_option__m_paren__m_list__m_argument a3 b3 >>= fun (a3, b3) ->
          return (A.New (a1, a2, a3), B.New (b1, b2, b3))
      | A.Clone (a1, a2), B.Clone (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Clone (a1, a2), B.Clone (b1, b2))
      | A.AssignRef (a1, a2, a3, a4), B.AssignRef (b1, b2, b3, b4) ->
          m_lvalue a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          m_lvalue a4 b4 >>= fun (a4, b4) ->
          return (A.AssignRef (a1, a2, a3, a4), B.AssignRef (b1, b2, b3, b4))
      | ( A.AssignNew (a1, a2, a3, a4, a5, a6),
          B.AssignNew (b1, b2, b3, b4, b5, b6) ) ->
          m_lvalue a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          m_class_name_reference a5 b5 >>= fun (a5, b5) ->
          (m_option (m_paren m_list__m_argument)) a6 b6 >>= fun (a6, b6) ->
          return
            ( A.AssignNew (a1, a2, a3, a4, a5, a6),
              B.AssignNew (b1, b2, b3, b4, b5, b6) )
      | A.Cast (a1, a2), B.Cast (b1, b2) ->
          m_wrap m_castOp a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Cast (a1, a2), B.Cast (b1, b2))
      | A.CastUnset (a1, a2), B.CastUnset (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.CastUnset (a1, a2), B.CastUnset (b1, b2))
      | A.InstanceOf (a1, a2, a3), B.InstanceOf (b1, b2, b3) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_class_name_reference a3 b3 >>= fun (a3, b3) ->
          return (A.InstanceOf (a1, a2, a3), B.InstanceOf (b1, b2, b3))
      | A.Eval (a1, a2), B.Eval (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_paren m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Eval (a1, a2), B.Eval (b1, b2))
      | A.Lambda _a1, B.Lambda _b1 -> raise Todo
      | A.ShortLambda _a1, B.ShortLambda _b1 -> raise Todo
      | A.XhpHtml a1, B.XhpHtml b1 ->
          m_xhp_html a1 b1 >>= fun (a1, b1) ->
          return (A.XhpHtml a1, B.XhpHtml b1)
      | A.Exit (a1, a2), B.Exit (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_option (m_paren (m_option m_expr))) a2 b2 >>= fun (a2, b2) ->
          return (A.Exit (a1, a2), B.Exit (b1, b2))
      | A.At (a1, a2), B.At (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) -> return (A.At (a1, a2), B.At (b1, b2))
      | A.Print (a1, a2), B.Print (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Print (a1, a2), B.Print (b1, b2))
      (* pad, iso on  ... *)
      | ( A.BackQuote (a1, [ A.EncapsString ("...", a2) ], a3),
          B.BackQuote (b1, b2, b3) ) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (* TODO? distribute info of a2? *)
          m_tok a3 b3 >>= fun (a3, b3) ->
          return
            ( A.BackQuote (a1, [ A.EncapsString ("...", a2) ], a3),
              B.BackQuote (b1, b2, b3) )
      | A.BackQuote (a1, a2, a3), B.BackQuote (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_list m_encaps a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.BackQuote (a1, a2, a3), B.BackQuote (b1, b2, b3))
      | A.Include (a1, a2), B.Include (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Include (a1, a2), B.Include (b1, b2))
      | A.IncludeOnce (a1, a2), B.IncludeOnce (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.IncludeOnce (a1, a2), B.IncludeOnce (b1, b2))
      | A.Require (a1, a2), B.Require (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Require (a1, a2), B.Require (b1, b2))
      | A.RequireOnce (a1, a2), B.RequireOnce (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.RequireOnce (a1, a2), B.RequireOnce (b1, b2))
      | A.Yield (a1, a2), B.Yield (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_array_pair a2 b2 >>= fun (a2, b2) ->
          return (A.Yield (a1, a2), B.Yield (b1, b2))
      | A.YieldBreak (a1, a2), B.YieldBreak (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          return (A.YieldBreak (a1, a2), B.YieldBreak (b1, b2))
      | A.Await (a1, a2), B.Await (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          return (A.Await (a1, a2), B.Await (b1, b2))
      | A.Empty (a1, a2), B.Empty (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_paren m_lvalue a2 b2 >>= fun (a2, b2) ->
          return (A.Empty (a1, a2), B.Empty (b1, b2))
      | A.Isset (a1, a2), B.Isset (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren (m_comma_list m_lvalue)) a2 b2 >>= fun (a2, b2) ->
          return (A.Isset (a1, a2), B.Isset (b1, b2))
      | A.ParenExpr a1, B.ParenExpr b1 ->
          m_paren m_expr a1 b1 >>= fun (a1, b1) ->
          return (A.ParenExpr a1, B.ParenExpr b1)
      | A.Id _, _
      | A.IdVar _, _
      | A.This _, _
      | A.Call _, _
      | A.ObjGet _, _
      | A.ClassGet _, _
      | A.ArrayGet _, _
      | A.HashGet _, _
      | A.BraceIdent _, _
      | A.Deref _, _
      | A.Sc _, _
      | A.Binary _, _
      | A.Unary _, _
      | A.Assign _, _
      | A.AssignOp _, _
      | A.Postfix _, _
      | A.Infix _, _
      | A.CondExpr _, _
      | A.AssignList _, _
      | A.ArrayLong _, _
      | A.ArrayShort _, _
      | A.Collection _, _
      | A.New _, _
      | A.Clone _, _
      | A.AssignRef _, _
      | A.AssignNew _, _
      | A.Cast _, _
      | A.CastUnset _, _
      | A.InstanceOf _, _
      | A.Eval _, _
      | A.Exit _, _
      | A.At _, _
      | A.Print _, _
      | A.BackQuote _, _
      | A.Include _, _
      | A.IncludeOnce _, _
      | A.Require _, _
      | A.RequireOnce _, _
      | A.Empty _, _
      | A.Isset _, _
      | A.XhpHtml _, _
      | A.Lambda _, _
      | A.ShortLambda _, _
      | A.ParenExpr _, _
      | A.Yield _, _
      | A.YieldBreak _, _
      | A.Await _, _ ->
          fail ()

    (* ---------------------------------------------------------------------- *)
    (* xhp (and a few xhp isos) *)
    (* ---------------------------------------------------------------------- *)
    and m_xhp_tag a b = match (a, b) with a, b -> (m_list m_string) a b

    and m_wrap_m_xhp_tag a b =
      m_name_metavar_ok (A.XhpName a) (B.XhpName b) >>= function
      | A.XhpName a, B.XhpName b -> return (a, b)
      | _ -> raise Impossible

    and m_wrap_m_option_m_xhp_tag (a, toka) (b, tokb) =
      match (a, b) with
      | None, None ->
          m_info toka tokb >>= fun (toka, tokb) -> return ((a, toka), (b, tokb))
      | Some a1, Some b1 ->
          m_wrap_m_xhp_tag (a1, toka) (b1, tokb)
          >>= fun ((a1, toka), (b1, tokb)) ->
          return ((Some a1, toka), (Some b1, tokb))
      (* todo: should be ok to use </> instead of explicit tag *)
      | None, Some _ | Some _, None -> fail ()

    and iso_m_list_m_xhp_body a b =
      match a with
      (* iso-by-absence: it's ok to have an empty body in the pattern *)
      | [] -> return (a, b)
      | [ A.XhpText ("\n", _) ] | [ A.XhpText ("\n\n", _) ] -> return (a, b)
      | _ -> (m_list m_xhp_body) a b

    and sort_xhp_attributes xs =
      xs
      |> List.map (fun attr ->
             let (attr_name, _ii), _tok, _value = attr in
             (attr_name, attr))
      |> Common.sort_by_key_highfirst |> List.map snd

    and iso_m_list_m_xhp_attribute a b =
      (* let's sort so don't care about order.
       * todo: if add metavar for attribut names then this will not work
       * anymore
       *)
      let a = sort_xhp_attributes a in
      let b = sort_xhp_attributes b in

      let rec aux a b =
        match (a, b) with
        (* iso-by-absence: it's ok to have less attr in the pattern *)
        | [], b -> return ([], b)
        | _, [] -> fail ()
        | x :: xs, y :: ys ->
            m_xhp_attribute x y
            >>= (fun (x, y) ->
                  aux xs ys >>= fun (xs, ys) -> return (x :: xs, y :: ys))
            >||> ( (* iso: allow to skip one attribute *)
                   aux (x :: xs) ys
                 >>= fun (xs, ys) -> return (xs, y :: ys) )
      in

      aux a b

    (* We want to allow multiple isomorphisms here.
     *
     * For instance it's ok to have attributes in different
     * order in the pattern or even missing attributes
     * (for people who wants to have a strict match for the attributes
     *  we could add a -strict_xhp to sgrep/spatch or have a
     *  special attribute like  NOATTR=true in the xhp expression itself).
     *
     * todo: it's also ok to have a Xhp pattern matching
     * a XhpSingleton or Xhp (hmmm but this may cause pb to spatch).
     *
     * Finally it's ok to have an empty xhp body. We may want
     * to add a "..." syntax for that instead of doing it by default.
     *)
    and m_xhp_html a b =
      match (a, b) with
      | A.Xhp (a1, a2, a3, a4, a5), B.Xhp (b1, b2, b3, b4, b5) ->
          m_wrap_m_xhp_tag a1 b1 >>= fun (a1, b1) ->
          iso_m_list_m_xhp_attribute a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          iso_m_list_m_xhp_body a4 b4 >>= fun (a4, b4) ->
          m_wrap_m_option_m_xhp_tag a5 b5 >>= fun (a5, b5) ->
          return (A.Xhp (a1, a2, a3, a4, a5), B.Xhp (b1, b2, b3, b4, b5))
      | A.XhpSingleton (a1, a2, a3), B.XhpSingleton (b1, b2, b3) ->
          (m_wrap m_xhp_tag) a1 b1 >>= fun (a1, b1) ->
          iso_m_list_m_xhp_attribute a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.XhpSingleton (a1, a2, a3), B.XhpSingleton (b1, b2, b3))
      | A.Xhp _, _ | A.XhpSingleton _, _ -> fail ()

    and m_xhp_attribute a b =
      match (a, b) with
      | (a1, a2, a3), (b1, b2, b3) ->
          m_xhp_attr_name a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_xhp_attr_value a3 b3 >>= fun (a3, b3) ->
          return ((a1, a2, a3), (b1, b2, b3))

    and m_xhp_attr_name a b =
      m_name_metavar_ok (A.Name a) (B.Name b) >>= function
      | A.Name a, B.Name b -> return (a, b)
      | _ -> raise Impossible

    and m_xhp_attr_value a b =
      match (a, b) with
      | A.SgrepXhpAttrValueMvar (name, i_name), b when MV.is_metavar_name name
        -> (
          X.envf (name, i_name) (B.XhpAttrValue b) >>= function
          | (name, i_name), B.XhpAttrValue b ->
              return (A.SgrepXhpAttrValueMvar (name, i_name), b)
          | _ -> raise Impossible )
      | A.XhpAttrString (a1, a2, a3), B.XhpAttrString (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_list m_encaps) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.XhpAttrString (a1, a2, a3), B.XhpAttrString (b1, b2, b3))
      | A.XhpAttrExpr a1, B.XhpAttrExpr b1 ->
          (m_brace m_expr) a1 b1 >>= fun (a1, b1) ->
          return (A.XhpAttrExpr a1, B.XhpAttrExpr b1)
      | A.XhpAttrString _, _ | A.XhpAttrExpr _, _ | A.SgrepXhpAttrValueMvar _, _
        ->
          fail ()

    and m_xhp_body a b =
      match (a, b) with
      | A.XhpText a1, B.XhpText b1 ->
          m_string_xhp_text a1 b1 >>= fun (a1, b1) ->
          return (A.XhpText a1, B.XhpText b1)
      | A.XhpExpr a1, B.XhpExpr b1 ->
          (m_brace m_expr) a1 b1 >>= fun (a1, b1) ->
          return (A.XhpExpr a1, B.XhpExpr b1)
      | A.XhpNested a1, B.XhpNested b1 ->
          m_xhp_html a1 b1 >>= fun (a1, b1) ->
          return (A.XhpNested a1, B.XhpNested b1)
      | A.XhpText _, _ | A.XhpExpr _, _ | A.XhpNested _, _ -> fail ()

    (* ---------------------------------------------------------------------- *)
    (* scalar and other expr *)
    (* ---------------------------------------------------------------------- *)
    and m_scalar a b =
      match (a, b) with
      | A.C a1, B.C b1 ->
          m_constant a1 b1 >>= fun (a1, b1) -> return (A.C a1, B.C b1)
      | A.Guil (a1, a2, a3), B.Guil (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_list m_encaps a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Guil (a1, a2, a3), B.Guil (b1, b2, b3))
      | A.HereDoc (a1, a2, a3), B.HereDoc (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_list m_encaps a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.HereDoc (a1, a2, a3), B.HereDoc (b1, b2, b3))
      | A.C _, _ | A.Guil _, _ | A.HereDoc _, _ -> fail ()

    and m_list_assign a b =
      match (a, b) with
      | A.ListVar a1, B.ListVar b1 ->
          m_lvalue a1 b1 >>= fun (a1, b1) -> return (A.ListVar a1, B.ListVar b1)
      | A.ListList (a1, a2), B.ListList (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren (m_comma_list m_list_assign)) a2 b2 >>= fun (a2, b2) ->
          return (A.ListList (a1, a2), B.ListList (b1, b2))
      | A.ListEmpty, B.ListEmpty -> return (A.ListEmpty, B.ListEmpty)
      | A.ListVar _, _ | A.ListList _, _ | A.ListEmpty, _ -> fail ()

    and m_array_pair a b =
      match (a, b) with
      | A.ArrayExpr a1, B.ArrayExpr b1 ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          return (A.ArrayExpr a1, B.ArrayExpr b1)
      | A.ArrayRef (a1, a2), B.ArrayRef (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_lvalue a2 b2 >>= fun (a2, b2) ->
          return (A.ArrayRef (a1, a2), B.ArrayRef (b1, b2))
      | A.ArrayArrowExpr (a1, a2, a3), B.ArrayArrowExpr (b1, b2, b3) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          return (A.ArrayArrowExpr (a1, a2, a3), B.ArrayArrowExpr (b1, b2, b3))
      | A.ArrayArrowRef (a1, a2, a3, a4), B.ArrayArrowRef (b1, b2, b3, b4) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          m_lvalue a4 b4 >>= fun (a4, b4) ->
          return
            (A.ArrayArrowRef (a1, a2, a3, a4), B.ArrayArrowRef (b1, b2, b3, b4))
      | A.ArrayExpr _, _
      | A.ArrayRef _, _
      | A.ArrayArrowExpr _, _
      | A.ArrayArrowRef _, _ ->
          fail ()

    and m_class_name_reference a b = m_expr a b

    and m_encaps a b =
      match (a, b) with
      | A.EncapsString a1, B.EncapsString b1 ->
          m_wrap m_string a1 b1 >>= fun (a1, b1) ->
          return (A.EncapsString a1, B.EncapsString b1)
      | A.EncapsVar a1, B.EncapsVar b1 ->
          m_lvalue a1 b1 >>= fun (a1, b1) ->
          return (A.EncapsVar a1, B.EncapsVar b1)
      | A.EncapsCurly (a1, a2, a3), B.EncapsCurly (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_lvalue a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.EncapsCurly (a1, a2, a3), B.EncapsCurly (b1, b2, b3))
      | A.EncapsDollarCurly (a1, a2, a3), B.EncapsDollarCurly (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_lvalue a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return
            (A.EncapsDollarCurly (a1, a2, a3), B.EncapsDollarCurly (b1, b2, b3))
      | A.EncapsExpr (a1, a2, a3), B.EncapsExpr (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.EncapsExpr (a1, a2, a3), B.EncapsExpr (b1, b2, b3))
      | A.EncapsString _, _
      | A.EncapsVar _, _
      | A.EncapsCurly _, _
      | A.EncapsDollarCurly _, _
      | A.EncapsExpr _, _ ->
          fail ()

    and m_constant a b =
      match (a, b) with
      | A.Int a1, B.Int b1 ->
          m_wrap m_string a1 b1 >>= fun (a1, b1) -> return (A.Int a1, B.Int b1)
      | A.Double a1, B.Double b1 ->
          m_wrap m_string a1 b1 >>= fun (a1, b1) ->
          return (A.Double a1, B.Double b1)
      (* bind the content of a string to a metavariable.
       * PHP has no first-class function or class so it's quite common
       * to pass around function or class name via strings, so it's convenient
       * to bind a metavariable to a string content and consider it
       * as an entity (a Name).
       *)
      | A.String (name, info_name), B.String (sb, info_sb)
        when MV.is_metavar_name name -> (
          (* removing the surrounding quotes *)
          let any1 = B.Ident2 (B.Name (sb, Parse_info.rewrap_str sb info_sb)) in

          let any2 = B.Expr (B.Sc (B.C (B.String (sb, info_sb)))) in

          X.envf2 (name, info_name) (any1, any2) >>= function
          | ( (name, info_name),
              (_any1, B.Expr (B.Sc (B.C (B.String (sb, info_sb))))) ) ->
              return (A.String (name, info_name), B.String (sb, info_sb))
          | _ -> raise Impossible )
      (* pad, iso on  name *)
      | A.String ("...", a), B.String (s, b) ->
          m_info a b >>= fun (a, b) ->
          return (A.String ("...", a), B.String (s, b))
      (* todo: handle spatch too! one could want to bind things to \1 \2
       * and reference those \xxx in the + side of a semantic patch.
       *)
      | A.String (name, info_name), B.String (sb, info_sb)
        when name =~ "^=~/\\(.*\\)/$" ->
          let s = Common.matched1 name in
          (*
      let rex = Pcre.regexp s in
      if Pcre.pmatch ~rex sb
*)
          if sb =~ s then
            m_info info_name info_sb >>= fun (info_name, info_sb) ->
            return (A.String (name, info_name), B.String (sb, info_sb))
          else fail ()
      | A.String a1, B.String b1 ->
          m_wrap m_string a1 b1 >>= fun (a1, b1) ->
          return (A.String a1, B.String b1)
      | A.PreProcess a1, B.PreProcess b1 ->
          m_wrap m_cpp_directive a1 b1 >>= fun (a1, b1) ->
          return (A.PreProcess a1, B.PreProcess b1)
      | A.XdebugClass (_a1, _a2), B.XdebugClass (_b1, _b2) ->
          (* no php_vs_php for class_stmt yet *)
          raise Todo
      | A.XdebugResource, B.XdebugResource ->
          return (A.XdebugResource, B.XdebugResource)
      | A.Int _, _
      | A.Double _, _
      | A.String _, _
      | A.PreProcess _, _
      | A.XdebugClass _, _
      | A.XdebugResource, _ ->
          fail ()

    (*---------------------------------------------------------------------------*)
    (* arguments list iso *)
    (*---------------------------------------------------------------------------*)
    (* todo: make this code generic ? but I need to dig into the element
     *  to find the SgrepExprDots so it is not be that easy to factorize.
     * update: actually can use the comma_list_dots technique which avoid
     *  digging and help factorize code!
     *)
    and m_list__m_argument (xsa : A.argument A.comma_list)
        (xsb : B.argument B.comma_list) =
      (*old: m_list m_argument xsa xsb *)
      match (xsa, xsb) with
      | [], [] -> return ([], [])
      (* iso on trailing comma *)
      | [ Right comma ], [] ->
          if is_NoTransfo comma || is_Remove comma then
            return ([ Right comma ], [])
          else
            failwith
              "'+' transformation on trailing comma is not allowed, rewrite \
               your spatch"
      (* todo: what if previous elt in spatch was to remove, we should
       * then remove this comma too no? right now this forces the spatch
       * write to use the trailing comma in his pattern.
       *)
      | [], [ Right comma ] -> return ([], [ Right comma ])
      (* iso on ... *)
      | [ Left (A.Arg (A.SgrepExprDots i)) ], _bbs ->
          (* todo: if remove could apply the transfo on bbs *)
          if is_NoTransfo i then return (xsa, xsb)
          else
            failwith
              "transformation (- or +) on '...' not allowed, rewrite your \
               spatch"
      (* iso on Boolean vs. Int *)
      | ( [ Left (A.Arg (A.Id (A.XName [ A.QI (A.Name (name_a, info_name)) ]))) ],
          [ Left (B.Arg (B.Sc (B.C (B.Int (name_b, _))))) ] )
        when is_bool_vs_int name_a name_b ->
          return ([ Left (B.Arg (B.Sc (B.C (B.Int (name_b, info_name))))) ], xsb)
      | ( [ Left (A.Arg (A.Id (A.XName [ A.QI (A.Name (name, info_name)) ]))) ],
          bbs )
        when MV.is_metavar_manyargs_name name -> (
          X.envf (name, info_name) (B.Arguments bbs) >>= function
          | (name, info_name), B.Arguments bbs ->
              return
                ( [
                    Left
                      (A.Arg
                         (A.Id (A.XName [ A.QI (A.Name (name, info_name)) ])));
                  ],
                  bbs )
          | _ -> raise Impossible )
      (* bugfix: we can have some Replace or AddAfter in the token of
       * the comma. We need to apply it to the code.
       *)
      | [ Right a; Left (A.Arg (A.SgrepExprDots i)) ], Right b :: bbs ->
          m_info a b >>= fun (a, b) ->
          return ([ Right a; Left (A.Arg (A.SgrepExprDots i)) ], Right b :: bbs)
      (* '...' can also match no argument.
       * this is ok in sgrep mode, but in spatch mode the comma
       * or SgrepExprDots could carry some transfo. What should we do?
       * Maybe just print warning.
       *)
      | [ Right a; Left (A.Arg (A.SgrepExprDots _i)) ], [] ->
          if is_NoTransfo a || is_Remove a then return (xsa, xsb)
          else
            failwith
              ( "transformation (- or +) on ',' not allowed when used with "
              ^ "'...'. Rewrite your spatch: put your trailing comma on the \
                 line " ^ "with the '...'. See also "
              ^ "https://github.com/facebook/pfff/wiki/Spatch#wiki-spacing-issues"
              )
      | ( [
            Right _;
            Left (A.Arg (A.Id (A.XName [ A.QI (A.Name (name, info_name)) ])));
          ],
          [] )
        when MV.is_metavar_manyargs_name name -> (
          X.envf (name, info_name) (B.Arguments []) >>= function
          | (_name, _info_name), B.Arguments [] -> return (xsa, xsb)
          | _ -> raise Impossible )
      | [ Right _; Left (A.Arg (A.SgrepExprDots _)) ], _bbs -> raise Impossible
      | Left (A.Arg (A.SgrepExprDots _)) :: _, _ ->
          failwith
            "... is allowed only at the end. Give money to pad to get this \
             feature"
      (* the general case *)
      | xa :: aas, xb :: bbs ->
          (m_either m_argument m_info) xa xb >>= fun (xa, xb) ->
          m_list__m_argument aas bbs >>= fun (aas, bbs) ->
          return (xa :: aas, xb :: bbs)
      | [], _ | _ :: _, _ -> fail ()

    (* iso: new Foo(...) can match new X; *)
    and m_option__m_paren__m_list__m_argument a b =
      match (a, b) with
      (* iso on ... *)
      | Some (_lp, [ Left (A.Arg (A.SgrepExprDots _)) ], _rp), None ->
          (* todo: for spatch need apply possible transfo *)
          return (a, b)
      | _ -> m_option (m_paren m_list__m_argument) a b

    (*---------------------------------------------------------------------------*)
    (* array list *)
    (*---------------------------------------------------------------------------*)

    (* todo: would be good to factorize code with m_list__m_argument *)
    and m_list__m_array_pair (xsa : A.array_pair A.comma_list)
        (xsb : B.array_pair B.comma_list) =
      match (xsa, xsb) with
      | [], [] -> return ([], [])
      (* iso on ... *)
      | [ Left (A.ArrayExpr (A.SgrepExprDots _)) ], _bbs ->
          (* TODO do different combinaisons *)
          return (xsa, xsb)
      | [ Right _; Left (A.ArrayExpr (A.SgrepExprDots _)) ], _bbs ->
          (* TODO do different combinaisons *)
          return (xsa, xsb)
      | Left (A.ArrayExpr (A.SgrepExprDots _)) :: _xs, _bbs ->
          failwith
            "... is allowed only at the end. Give money to pad to get this \
             feature"
      | xa :: aas, xb :: bbs ->
          (m_either m_array_pair m_info) xa xb >>= fun (xa, xb) ->
          m_list__m_array_pair aas bbs >>= fun (aas, bbs) ->
          return (xa :: aas, xb :: bbs)
      | [], _ | _ :: _, _ -> fail ()

    (*---------------------------------------------------------------------------*)
    (* comma list dots iso *)
    (*---------------------------------------------------------------------------*)
    and m_comma_list_dots :
          'a 'b. ('a -> 'b -> X.tin -> ('a * 'b) X.tout) ->
          'a A.comma_list_dots -> 'b B.comma_list_dots -> X.tin ->
          ('a A.comma_list_dots * 'b B.comma_list_dots) X.tout =
     fun f xsa xsb ->
      match (xsa, xsb) with
      | [], [] -> return ([], [])
      (* iso on ... *)
      | [ Middle3 _infoTodo ], _bbs ->
          (* TODO do different combinaisons, and apply token *)
          return (xsa, xsb)
      | [ Right3 _; Middle3 _ ], _bbs ->
          (* TODO do different combinaisons *)
          return (xsa, xsb)
      | Middle3 _ :: _xs, _bbs ->
          failwith
            "... is allowed for now only at the end. Give money to pad to get \
             this feature"
      | xa :: aas, xb :: bbs ->
          (m_either3 f m_info m_info) xa xb >>= fun (xa, xb) ->
          m_comma_list_dots f aas bbs >>= fun (aas, bbs) ->
          return (xa :: aas, xb :: bbs)
      | [], _ | _ :: _, _ -> fail ()

    (* ---------------------------------------------------------------------- *)
    (* stmt *)
    (* ---------------------------------------------------------------------- *)
    and m_stmt a b =
      match (a, b) with
      | A.ExprStmt (a1, a2), B.ExprStmt (b1, b2) ->
          m_expr a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          return (A.ExprStmt (a1, a2), B.ExprStmt (b1, b2))
      | A.EmptyStmt a1, B.EmptyStmt b1 ->
          m_tok a1 b1 >>= fun (a1, b1) -> return (A.EmptyStmt a1, B.EmptyStmt b1)
      | A.Block a1, B.Block b1 ->
          (m_brace (m_list m_stmt_and_def)) a1 b1 >>= fun (a1, b1) ->
          return (A.Block a1, B.Block b1)
      | A.If (a1, a2, a3, a4, a5), B.If (b1, b2, b3, b4, b5) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren m_expr) a2 b2 >>= fun (a2, b2) ->
          m_stmt a3 b3 >>= fun (a3, b3) ->
          (m_list m_if_elseif) a4 b4 >>= fun (a4, b4) ->
          (m_option m_if_else) a5 b5 >>= fun (a5, b5) ->
          return (A.If (a1, a2, a3, a4, a5), B.If (b1, b2, b3, b4, b5))
      | ( A.IfColon (a1, a2, a3, a4, a5, a6, a7, a8),
          B.IfColon (b1, b2, b3, b4, b5, b6, b7, b8) ) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren m_expr) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          (m_list m_stmt_and_def) a4 b4 >>= fun (a4, b4) ->
          (m_list m_new_elseif) a5 b5 >>= fun (a5, b5) ->
          (m_option m_new_else) a6 b6 >>= fun (a6, b6) ->
          m_tok a7 b7 >>= fun (a7, b7) ->
          m_tok a8 b8 >>= fun (a8, b8) ->
          return
            ( A.IfColon (a1, a2, a3, a4, a5, a6, a7, a8),
              B.IfColon (b1, b2, b3, b4, b5, b6, b7, b8) )
      | A.While (a1, a2, a3), B.While (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren m_expr) a2 b2 >>= fun (a2, b2) ->
          m_colon_stmt a3 b3 >>= fun (a3, b3) ->
          return (A.While (a1, a2, a3), B.While (b1, b2, b3))
      | A.Do (a1, a2, a3, a4, a5), B.Do (b1, b2, b3, b4, b5) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_stmt a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          (m_paren m_expr) a4 b4 >>= fun (a4, b4) ->
          m_tok a5 b5 >>= fun (a5, b5) ->
          return (A.Do (a1, a2, a3, a4, a5), B.Do (b1, b2, b3, b4, b5))
      | ( A.For (a1, a2, a3, a4, a5, a6, a7, a8, a9),
          B.For (b1, b2, b3, b4, b5, b6, b7, b8, b9) ) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_for_expr a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          m_for_expr a5 b5 >>= fun (a5, b5) ->
          m_tok a6 b6 >>= fun (a6, b6) ->
          m_for_expr a7 b7 >>= fun (a7, b7) ->
          m_tok a8 b8 >>= fun (a8, b8) ->
          m_colon_stmt a9 b9 >>= fun (a9, b9) ->
          return
            ( A.For (a1, a2, a3, a4, a5, a6, a7, a8, a9),
              B.For (b1, b2, b3, b4, b5, b6, b7, b8, b9) )
      | A.Switch (a1, a2, a3), B.Switch (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren m_expr) a2 b2 >>= fun (a2, b2) ->
          m_switch_case_list a3 b3 >>= fun (a3, b3) ->
          return (A.Switch (a1, a2, a3), B.Switch (b1, b2, b3))
      | ( A.Foreach (a1, a2, a3, a4, a5, a6, a7, a8),
          B.Foreach (b1, b2, b3, b4, b5, b6, b7, b8) ) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_expr a3 b3 >>= fun (a3, b3) ->
          m_option m_tok a4 b4 >>= fun (a4, b4) ->
          m_tok a5 b5 >>= fun (a5, b5) ->
          m_foreach_pattern a6 b6 >>= fun (a6, b6) ->
          m_tok a7 b7 >>= fun (a7, b7) ->
          m_colon_stmt a8 b8 >>= fun (a8, b8) ->
          return
            ( A.Foreach (a1, a2, a3, a4, a5, a6, a7, a8),
              B.Foreach (b1, b2, b3, b4, b5, b6, b7, b8) )
      | A.Break (a1, a2, a3), B.Break (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_option m_expr) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Break (a1, a2, a3), B.Break (b1, b2, b3))
      | A.Continue (a1, a2, a3), B.Continue (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_option m_expr) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Continue (a1, a2, a3), B.Continue (b1, b2, b3))
      | A.Return (a1, a2, a3), B.Return (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_option m_expr) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Return (a1, a2, a3), B.Return (b1, b2, b3))
      | A.Throw (a1, a2, a3), B.Throw (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_expr a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Throw (a1, a2, a3), B.Throw (b1, b2, b3))
      | A.Try (a1, a2, a3, a4), B.Try (b1, b2, b3, b4) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_brace (m_list m_stmt_and_def)) a2 b2 >>= fun (a2, b2) ->
          (m_list m_catch) a3 b3 >>= fun (a3, b3) ->
          (m_list m_finally) a4 b4 >>= fun (a4, b4) ->
          return (A.Try (a1, a2, a3, a4), B.Try (b1, b2, b3, b4))
      | A.Echo (a1, a2, a3), B.Echo (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_comma_list m_expr) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Echo (a1, a2, a3), B.Echo (b1, b2, b3))
      | A.Globals (a1, a2, a3), B.Globals (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_comma_list m_global_var) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Globals (a1, a2, a3), B.Globals (b1, b2, b3))
      | A.StaticVars (a1, a2, a3), B.StaticVars (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_comma_list m_static_var) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.StaticVars (a1, a2, a3), B.StaticVars (b1, b2, b3))
      | A.InlineHtml a1, B.InlineHtml b1 ->
          (m_wrap m_string) a1 b1 >>= fun (a1, b1) ->
          return (A.InlineHtml a1, B.InlineHtml b1)
      | A.Use (a1, a2, a3), B.Use (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_use_filename a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Use (a1, a2, a3), B.Use (b1, b2, b3))
      | A.Unset (a1, a2, a3), B.Unset (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren (m_comma_list m_lvalue)) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          return (A.Unset (a1, a2, a3), B.Unset (b1, b2, b3))
      | A.Declare (a1, a2, a3), B.Declare (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_paren (m_comma_list m_declare)) a2 b2 >>= fun (a2, b2) ->
          m_colon_stmt a3 b3 >>= fun (a3, b3) ->
          return (A.Declare (a1, a2, a3), B.Declare (b1, b2, b3))
      | A.FuncDefNested _a1, B.FuncDefNested _b1 -> fail2 "FuncDefNested"
      | A.ClassDefNested a1, B.ClassDefNested b1 ->
          m_class_def a1 b1 >>= fun (a1, b1) ->
          return (A.ClassDefNested a1, B.ClassDefNested b1)
      | A.ExprStmt _, _
      | A.EmptyStmt _, _
      | A.Block _, _
      | A.If _, _
      | A.IfColon _, _
      | A.While _, _
      | A.Do _, _
      | A.For _, _
      | A.Switch _, _
      | A.Foreach _, _
      | A.Break _, _
      | A.Continue _, _
      | A.Return _, _
      | A.Throw _, _
      | A.Try _, _
      | A.Echo _, _
      | A.Globals _, _
      | A.StaticVars _, _
      | A.InlineHtml _, _
      | A.Use _, _
      | A.Unset _, _
      | A.Declare _, _
      | A.FuncDefNested _, _
      | A.ClassDefNested _, _ ->
          fail ()

    and m_stmt_and_def a b = m_stmt a b

    and m_colon_stmt a b =
      match (a, b) with
      | A.SingleStmt a1, B.SingleStmt b1 ->
          m_stmt a1 b1 >>= fun (a1, b1) ->
          return (A.SingleStmt a1, B.SingleStmt b1)
      | A.ColonStmt (a1, a2, a3, a4), B.ColonStmt (b1, b2, b3, b4) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_list m_stmt_and_def) a2 b2 >>= fun (a2, b2) ->
          m_tok a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          return (A.ColonStmt (a1, a2, a3, a4), B.ColonStmt (b1, b2, b3, b4))
      | A.SingleStmt _, _ | A.ColonStmt _, _ -> fail ()

    (* ---------------------------------------------------------------------- *)
    (* stmt auxilaries *)
    (* ---------------------------------------------------------------------- *)
    and m_foreach_pattern _a _b = raise Todo

    and m_foreach_variable a b =
      match (a, b) with
      | (a1, a2), (b1, b2) ->
          m_is_ref a1 b1 >>= fun (a1, b1) ->
          m_lvalue a2 b2 >>= fun (a2, b2) -> return ((a1, a2), (b1, b2))

    and m_is_ref a b = m_option m_tok a b

    and m_foreach_arrow _a _b = fail2 "m_foreach_arrow"

    and m_if_elseif _a _b = fail2 "m_if_elseif"

    and m_if_else _a _b = fail2 "m_if_else"

    and m_new_elseif _a _b = fail2 "m_new_elseif"

    and m_new_else _a _b = fail2 "m_new_else"

    and m_for_expr _a _b = fail2 "m_for_expr"

    and m_switch_case_list _a _b = fail2 "m_switch_case_list"

    and m_case _a _b = fail2 "m_case"

    and m_catch _a _b = fail2 "m_catch"

    and m_finally _a _b = fail2 "m_finally"

    and m_global_var _a _b = fail2 "m_global_var"

    and m_static_var _a _b = fail2 "m_static_var"

    and m_use_filename _a _b = fail2 "m_use_filename"

    and m_declare _a _b = fail2 "m_declare"

    and m_modifiers x = m_list (m_wrap m_modifier) x

    and m_type a b = return (a, b)

    and m_attributes _a _b = raise Todo

    and m_xhp_children_decl _a _b = raise Todo

    and m_hint_type a b =
      match (a, b) with
      | A.Hint (A.XName [ A.QI (A.Name (name, info_name)) ], None), B.Hint (_, _)
        when MV.is_metavar_name name -> (
          X.envf (name, info_name) (B.Hint2 b) >>= function
          | (name, info_name), B.Hint2 b ->
              return
                (A.Hint (A.XName [ A.QI (A.Name (name, info_name)) ], None), b)
          | _ -> raise Impossible )
      | A.Hint (a1, a2), B.Hint (b1, b2) ->
          m_name a1 b1 >>= fun (a1, b1) ->
          m_option m_type_args a2 b2 >>= fun (a2, b2) ->
          return (A.Hint (a1, a2), B.Hint (b1, b2))
      | A.HintArray a1, B.HintArray b1 ->
          m_tok a1 b1 >>= fun (a1, b1) -> return (A.HintArray a1, B.HintArray b1)
      | A.HintQuestion (at, a1), B.HintQuestion (bt, b1) ->
          m_tok at bt >>= fun (at, bt) ->
          m_hint_type a1 b1 >>= fun (a1, b1) ->
          return (A.HintQuestion (at, a1), B.HintQuestion (bt, b1))
      | A.HintTuple v1, B.HintTuple v2 ->
          (m_paren (m_comma_list m_hint_type)) v1 v2 >>= fun (v1, v2) ->
          return (A.HintTuple v1, B.HintTuple v2)
      | ( A.HintCallback (lp1, (tok1, args1, ret1), rp1),
          B.HintCallback (lp2, (tok2, args2, ret2), rp2) ) ->
          m_tok lp1 lp2 >>= fun (lp1, lp2) ->
          m_tok tok1 tok2 >>= fun (tok1, tok2) ->
          (m_paren (m_comma_list_dots m_hint_type)) args1 args2
          >>= fun (args1, args2) ->
          (m_option m_hint_type_ret) ret1 ret2 >>= fun (ret1, ret2) ->
          return
            ( A.HintCallback (lp1, (tok1, args1, ret1), rp1),
              B.HintCallback (lp2, (tok2, args2, ret2), rp2) )
      | A.HintShape (a1, a2), B.HintShape (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_paren (m_comma_list m_shape_field) a2 b2 >>= fun (a2, b2) ->
          return (A.HintShape (a1, a2), B.HintShape (b1, b2))
      | A.HintTypeConst (a1, a2, a3), B.HintTypeConst (b1, b2, b3) ->
          m_hint_type a1 b1 >>= fun (a1, b1) ->
          m_tok a2 b2 >>= fun (a2, b2) ->
          m_hint_type a3 b3 >>= fun (a3, b3) ->
          return (A.HintTypeConst (a1, a2, a3), B.HintTypeConst (b1, b2, b3))
      | A.HintVariadic (a1, a2), B.HintVariadic (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_option m_hint_type a2 b2 >>= fun (a2, b2) ->
          return (A.HintVariadic (a1, a2), B.HintVariadic (b1, b2))
      | A.Hint _, _
      | A.HintArray _, _
      | A.HintQuestion _, _
      | A.HintTuple _, _
      | A.HintCallback _, _
      | A.HintShape _, _
      | A.HintTypeConst _, _
      | A.HintVariadic _, _ ->
          fail ()

    and m_hint_type_ret (a1, a2, a3) (b1, b2, b3) =
      m_tok a1 b1 >>= fun (a1, b1) ->
      (m_option m_tok) a2 b2 >>= fun (a2, b2) ->
      m_hint_type a3 b3 >>= fun (a3, b3) -> return ((a1, a2, a3), (b1, b2, b3))

    and m_shape_field (a1, a2, a3) (b1, b2, b3) =
      m_expr a1 b1 >>= fun (a1, b1) ->
      m_tok a2 b2 >>= fun (a2, b2) ->
      m_hint_type a3 b3 >>= fun (a3, b3) -> return ((a1, a2, a3), (b1, b2, b3))

    (* ------------------------------------------------------------------------- *)
    (* Class definition *)
    (* ------------------------------------------------------------------------- *)
    and m_class_def _a _b = fail2 "m_class_def"

    and m_interface_def _a _b = fail2 "m_interface_def"

    and m_trait_def _a _b = fail2 "m_trait_def"

    and m_method_def _a _b = fail2 "m_method_def"

    and m_class_constant a b =
      match (a, b) with
      | (a1, a2), (b1, b2) ->
          m_ident a1 b1 >>= fun (a1, b1) ->
          (m_option m_static_scalar_affect) a2 b2 >>= fun (a2, b2) ->
          return ((a1, a2), (b1, b2))

    and m_class_stmt a b =
      match (a, b) with
      | ( A.ClassConstants (a0, a1, a2, a3, a4),
          B.ClassConstants (b0, b1, b2, b3, b4) ) ->
          m_option m_tok a0 b0 >>= fun (a0, b0) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_option m_hint_type) a2 b2 >>= fun (a2, b2) ->
          (m_comma_list m_class_constant) a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          return
            ( A.ClassConstants (a0, a1, a2, a3, a4),
              B.ClassConstants (b0, b1, b2, b3, b4) )
      | A.ClassVariables (a1, a2, a3, a4), B.ClassVariables (b1, b2, b3, b4) ->
          m_class_var_modifier a1 b1 >>= fun (a1, b1) ->
          (m_option m_hint_type) a2 b2 >>= fun (a2, b2) ->
          (m_comma_list m_class_variable) a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          return
            ( A.ClassVariables (a1, a2, a3, a4),
              B.ClassVariables (b1, b2, b3, b4) )
      | A.Method a1, B.Method b1 ->
          m_method_def a1 b1 >>= fun (a1, b1) ->
          return (A.Method a1, B.Method b1)
      | A.XhpDecl a1, B.XhpDecl b1 ->
          m_xhp_decl a1 b1 >>= fun (a1, b1) ->
          return (A.XhpDecl a1, B.XhpDecl b1)
      | A.UseTrait (a1, a2, a3), B.UseTrait (b1, b2, b3) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          (m_comma_list m_hint_type) a2 b2 >>= fun (a2, b2) ->
          (m_either m_tok (m_brace (m_list m_trait_rule))) a3 b3
          >>= fun (a3, b3) ->
          return (A.UseTrait (a1, a2, a3), B.UseTrait (b1, b2, b3))
      | A.TraitConstraint (a1, a2, a3, a4), B.TraitConstraint (b1, b2, b3, b4)
        ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_wrap m_trait_constraint_kind a2 b2 >>= fun (a2, b2) ->
          m_hint_type a3 b3 >>= fun (a3, b3) ->
          m_tok a4 b4 >>= fun (a4, b4) ->
          return
            ( A.TraitConstraint (a1, a2, a3, a4),
              B.TraitConstraint (b1, b2, b3, b4) )
      | A.ClassType _, _
      | A.ClassConstants _, _
      | A.ClassVariables _, _
      | A.Method _, _
      | A.XhpDecl _, _
      | A.UseTrait _, _
      | A.TraitConstraint _, _ ->
          fail ()

    and m_trait_rule = m_unit

    and m_trait_constraint_kind a b =
      match (a, b) with
      | A.MustExtend, B.MustExtend | A.MustImplement, B.MustImplement ->
          return (a, b)
      | _ -> fail ()

    and m_class_variable a b =
      match (a, b) with
      | (a1, a2), (b1, b2) ->
          m_dname a1 b1 >>= fun (a1, b1) ->
          (m_option m_static_scalar_affect) a2 b2 >>= fun (a2, b2) ->
          return ((a1, a2), (b1, b2))

    and m_modifier a b =
      match (a, b) with
      | A.Public, B.Public -> return (A.Public, B.Public)
      | A.Private, B.Private -> return (A.Private, B.Private)
      | A.Protected, B.Protected -> return (A.Protected, B.Protected)
      | A.Static, B.Static -> return (A.Static, B.Static)
      | A.Abstract, B.Abstract -> return (A.Abstract, B.Abstract)
      | A.Final, B.Final -> return (A.Final, B.Final)
      | A.Async, B.Async -> return (A.Async, B.Async)
      | A.Public, _
      | A.Private, _
      | A.Protected, _
      | A.Static, _
      | A.Abstract, _
      | A.Final, _
      | A.Async, _ ->
          fail ()

    and m_class_var_modifier a b =
      match (a, b) with
      | A.NoModifiers a1, B.NoModifiers b1 ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          return (A.NoModifiers a1, B.NoModifiers b1)
      | A.VModifiers a1, B.VModifiers b1 ->
          (m_list (m_wrap m_modifier)) a1 b1 >>= fun (a1, b1) ->
          return (A.VModifiers a1, B.VModifiers b1)
      | A.NoModifiers _, _ | A.VModifiers _, _ -> fail ()

    (* ------------------------------------------------------------------------- *)
    (* Other declarations *)
    (* ------------------------------------------------------------------------- *)
    and m_xhp_decl _a _b = fail2 "m_xhp_decl"

    and m_xhp_attribute_decl _a _b = fail2 "m_xhp_decl"

    and m_static_scalar a b = m_expr a b

    and m_static_scalar_affect a b =
      match (a, b) with
      | (a1, a2), (b1, b2) ->
          m_tok a1 b1 >>= fun (a1, b1) ->
          m_static_scalar a2 b2 >>= fun (a2, b2) -> return ((a1, a2), (b1, b2))
  end
